home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / Asm Source / parser < prev    next >
Text File  |  1996-11-17  |  6KB  |  177 lines
  1. \ ---- FILE: parser ---------------- \ 
  2.  
  3. \ Sep 96 BDA  Use asembler to rewrite ParseToken.
  4.  
  5. 0 -> dlevel 
  6. 0    value    POS                \ position on line 
  7. 0    value    LINECT 
  8. 0    value    STOREDTOKEN 
  9. 0    value    CHARCOUNT        \ char in definition 
  10.  
  11.     string  TOKEN 
  12.  
  13. \ New Charclass
  14. \ We now return 0 for digits and 1 for letters.
  15.  
  16. code CHARCLASS  \ :code CHARCLASS \ New September 1,1996 BA- 
  17. hex             \ loc
  18. 0C00 w, 0020 w, \ CMPI.B #$20,D0 ; ' ' Blank
  19. 6F5C w,         \ BLE.S  cntrl
  20. 0C00 w, 0041 w, \ CMPI.B #$41,D0  ; 'A'
  21. 6D16 w,         \ BLT.S  trydig
  22. 0C00 w, 005A w, \ CMPI.B #$5A,D0 ; 'Z'
  23. 6F5E w,         \ BLE.S  maybe
  24. 0C00 w, 0061 w, \ CMPI.B #$61,D0 ; 'a'
  25. 6D16 w,         \ BLT.S  tryspec
  26. 0C00 w, 007A w, \ CMPI.B #$7A,D0 ; 'z'
  27. 6F52 w,         \ BLE.S  maybe     ;
  28. 7002 w,         \ MOVEQ  #$02,D0 ; special Everything above 'z'
  29. 4E75 w,         \ RTS
  30. 0C00 w, 0030 w, \ trydig  CMPI.B #$30,D0 ; '0'
  31. 6D06 w,         \         BLT.S  tryspec
  32. 0C00 w, 0039 w, \         CMPI.B #$39,D0 ; '9'
  33. 6F3E w,         \         BLE.S  digit
  34. 0C00 w, 0028 w, \ tryspec CMPI.B #$28,D0 ; '('
  35. 6732 w,         \         BEQ.S  letter
  36. 0C00 w, 0029 w, \         CMPI.B #$29,D0 ; ')'
  37. 672C w,         \         BEQ.S  letter
  38. 0C00 w, 0024 w, \         CMPI.B #$24,D0 ; '$'
  39. 672A w,         \         BEQ.S  dollar
  40. 0C00 w, 002D w, \         CMPI.B #$2D,D0 ; '-'
  41. 6710 w,         \         BEQ.S  minus
  42. 0C00 w, 003B w, \         CMPI.B #$3B,D0 ; ';'
  43. 671A w,         \         BEQ.S   letter
  44. 0C00 w, 002B w, \         CMPI.B #$2B,D0 ; '+'
  45. 671A w,         \         BEQ.S  digit
  46. 7002 w,         \         MOVEQ  #$02,D0 ; special
  47. 4E75 w,         \         RTS
  48. 1210 w,         \ minus MOVE.B (A0),D1 ;  Look at next char
  49. 0C01 w, 0028 w, \       CMPI.B #$28,D1 ; '(' -( If we're in a word,
  50. 6708 w,         \       BEQ.S  letter  ;  it's a spec,  
  51. 2004 w,         \       MOVE.L D4,D0   ;  otherwise a digit.
  52. 4E75 w,         \       RTS
  53. 7003 w,         \ cntrl  MOVEQ #$03,D0
  54. 4E75 w,         \        RTS
  55. 7001 w,         \ letter MOVEQ #$01,D0
  56. 4E75 w,         \ RTS
  57. 7400 w,         \ dollar MOVEQ #$00,D2 ; Change Aa..Zz to digit in case
  58. 7000 w,         \ digit  MOVEQ #$00,D0 ; BASE >10
  59. 4E75 w,         \ RTS
  60. 2002 w,         \ maybe MOVE.L D2,D0
  61. 4E75 w,         \ ;code 
  62.  
  63. decimal 
  64.  
  65. code PARSETOKEN   \ :code  PARSETOKEN \ New September 1,1996 BA- Requires the
  66.                                       \ New charclass to function
  67. hex               \       loc
  68. 2C1E w,           \       POP     D6
  69. 6724 w,           \       BEQ.S   eol
  70. 5346 w,           \       SUBQ.W  #$1,D6
  71. 7401 w,           \       MOVEQ   #$01,D2  ; Set maybe to return letter
  72. 2056 w,           \       MOVEA.L (A6),A0  ; DUP POP A0
  73. 7800 w,           \       MOVEQ   #$00,D4  ; Initially '-' is to be a digit
  74. 7A20 w,           \       MOVEQ   #$20,D5  ; ' ' Setup bloop
  75. 1018 w,           \ bloop   MOVE.B  (A0)+,D0 ; Skip blanks
  76. B005 w,           \         CMP.B   D5,D0
  77. 52CE w, FFFA w,   \         DBHI    D6,bloop
  78. 6F10 w,           \       BLE.S   eol
  79. 2248 w,           \   MOVEA.L A0,A1  ; Test the first char.
  80. 6100 w, FF5E w,   \   BSR     dic[charclass]
  81. 671E w,           \   BEQ.S   number
  82. 5340 w,           \   SUBQ.W  #$1,D0
  83. 672C w,           \   BEQ.S   word
  84. 7803 w,           \   MOVEQ   #$03,D4 ;  special
  85. 6042 w,           \   BRA.S   kleanup
  86. 4296 w,           \ eol  CLR.L (A6)  ; DROP PUSH #0
  87. 2D3C w, 0 w, 4 w, \      PUSH #4
  88. 2D3C w, 0 w, 0 w, \      PUSH #0 
  89. 2D3C w, 0 w, 0 w, \      PUSH #0 
  90. 4E75 w,           \      RTS
  91. 7801 w,           \ number MOVEQ  #$01,D4 ; set '-' to be a digit
  92. 5346 w,           \        SUBQ.W #$1,D6
  93. 6B24 w,           \        BMI.S  end
  94. 1018 w,           \ numloop  MOVE.B (A0)+,D0
  95. 6100 w, FF32 w,   \          BSR    dic[charclass]
  96. 56CE w, FFF8 w,   \          DBNE   D6,numloop
  97. 6012 w,           \        BRA.S  endtst
  98. 7802 w,           \ word  MOVEQ  #$02,D4 ; set '-' to be a special
  99. 5346 w,           \       SUBQ.W #$1,D6
  100. 6B12 w,           \       BMI.S  end
  101. 1018 w,           \ wdloop   MOVE.B (A0)+,D0
  102. 6100 w, FF20 w,   \          BSR    dic[charclass]
  103. 5300 w,           \          SUBQ.B #$01,D0
  104. 52CE w, FFF6 w,   \          DBHI   D6,wdloop
  105. 4A46 w,           \ endtst TST.W   D6     ; <-Need this to get the 
  106. 6B02 w,           \        BMI.S   end    ; string  length right
  107. 5388 w,           \        SUBQ.L  #$1,A0
  108. 5246 w,           \ end    ADDQ.W    #$1,D6
  109. 2C86 w,           \ kleanup   MOVE.L D6,(A6) ; DROP PUSH D6
  110. 2D04 w,           \           PUSH   D4
  111. 5389 w,           \           SUBQ.L #$1,A1
  112. 2209 w,           \           MOVE.L A1,D1
  113. 2D09 w,           \           PUSH   A1
  114. 91C1 w,           \           SUBA.L D1,A0
  115. 2D08 w,           \           PUSH   A0
  116. 4E75 w,           \ ;code 
  117. decimal 
  118.  
  119.  
  120. false    value    LABEL_THERE?    \ Set true if this line has a token at the
  121.                                 \  start - i.e. a label.  Used by main loop. 
  122.  
  123. : GETLINE  { \ #chars ch -- }
  124.     msg" getLine called"
  125.     (Frefill)  0= ?error 154            \ Premature end of file
  126.     bytesRead: topFile  ++> charCount    \ May be different to #TIB @
  127.     #tib @  -> #chars
  128.     0 -> pos
  129.     1 ++> linect
  130.     #chars
  131.      IF
  132.         tib c@  -> ch
  133.         ch bl =
  134.         IF  false
  135.         ELSE ch & ; =
  136.             IF  false
  137.             ELSE ch & \ =  IF  false  ELSE  true  THEN
  138.             THEN
  139.         THEN
  140.     ELSE
  141.         false
  142.     THEN
  143.     -> label_there?  ;
  144.  
  145.  
  146. : RestOfLine  \ ( -- addr len )
  147.     tib pos +  #tib @ pos -  ; 
  148.  
  149.  
  150. \ NEXTTOKEN puts the token into string Token and returns one of the following
  151. \  four token types:
  152. \        number, word, special, end-of-line
  153.  
  154. : NEXTTOKEN  { \ aa bb cc dd ee -- tokenType } 
  155.  
  156.     \ Note: the locals are dummies to force regs to be saved over the
  157.     \ ParseToken call!! 
  158.  
  159.     clear: token
  160.     storedToken
  161.     NIF
  162.         restOfLine parseToken put: token 
  163.         dup eol =
  164.         IF
  165.             2drop  eol
  166.         ELSE
  167.             swap ( # chars left )  #tib @  over -  -> pos
  168.             NIF  eol -> storedToken  THEN
  169.         THEN
  170.     ELSE
  171.         storedToken
  172.         0 -> storedToken
  173.     THEN
  174.     uc: token  2drop  ;  
  175.  
  176. endload
  177.